R Shiny - Extracting Anti-Diagonal elements in matrix using for-loops - for-loop

I am trying to create an R Shiny app which can read matrix inputs and extract the anti-diagonal elements, however, I can't figure out why the codes don't work as the way I wanted.
Below are the sample codes:
library(shinyMatrix)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyjs)
library(rhandsontable)
library(matrixStats)
ui =
dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(disable = TRUE),
dashboardBody(rHandsontableOutput("input1"),
br(),
rHandsontableOutput("input2"),
br(),
rHandsontableOutput("results")))
server = function (input, output, session) {
output$input1 = renderRHandsontable({
MAT = matrix(as.numeric(''), nrow = 3, ncol = 3,
dimnames = list(paste(1:3), paste(1:3)))
rhandsontable(MAT, width = "100%", height = "100%") %>%
hot_col(col = c(1:3), valign = 'htCenter', format = "0,0")
})
row_input <- reactive({
req(input$input1)
my_input_matrix <- as.matrix(hot_to_r(input$input1))
my_input_row<- as.matrix(hot_to_r(input$input1))
for(i in 1:3) {
my_input_row[i] = sum(my_input_matrix[,i])
}
row_input = matrix(my_input_row, nrow = 1, ncol = 3,
dimnames = list("Rowname", paste(1:3)))
row_input
})
output$input2 <- renderRHandsontable({
rhandsontable(row_input())
})
table <- reactive({
my_input_matrix <- as.data.frame(hot_to_r(input$input1))
my_input_row <- as.data.frame(hot_to_r(input$input2))
my_table <- as.data.frame(hot_to_r(input$input1),
hot_to_r(input$input2))
for(i in 1:3) {
for(j in 3:1) {
my_table[,1] <- my_input_matrix[j,i]
my_table[,2] <- my_input_matrix[i,j]
}
}
table = data.frame("A" = my_table[,1],
"B" = my_table[,2],
stringsAsFactors = FALSE,
check.names = FALSE)
table
})
output$results = renderRHandsontable({
rhandsontable(table())
})
}
shinyApp(ui, server)
Below is the sample inputs and outputs:
1st table is the input matrix
2nd table is a 1-row output matrix which shows the sum of each column of the 1st table(not sure if this causes the issue, so I'll just put it there)
3rd table is the output table produced by the codes
Here is the issue, I want the 3rd table to show the anti-diagonal elements 7-5-3 in column A and "reverse anti-diagonal" elements 3-5-7 in column B from the 1st table like below instead of the above (3-3-3- and 7-7-7).
Please help! Thanks!

Solved the issue by changing the codes to below:
for(i in 1:3) {
for(j in 3:1) {
my_table[,1] <- rev(my_input_matrix[i+(j-1)*3])[i]
my_table[,2] <- my_input_matrix[i+(j-1)*3][i]
}
}

Related

Google Apps Script - Copy Paste values on same page and in same row based on cell criteria

I have a table with data in columns A:Ak. Some of the data contains formulas and when a row of data is complete (i.e. the status in column W is "Y") I would like to copy that row in place and only past the values.
This is what I have tried:
function Optimize() {
var sheet = SpreadsheetApp.getActiveSheet();
var rows = sheet.getDataRange();
var numRows = rows.getNumRows();
var values = rows.getValues();
for (var i = 0; i <= numRows - 1; i++) {
var row = values[i];
// This searches all cells in columns W copies and pastes values in row if cell has value 'Y'
if (row[22] == 'Y') {
sheet.getDataRange(sheet.getCurrentCell().getRow() - 0, 1, 1, sheet.getMaxColumns()).activate();
sheet.getActiveRange().copyTo(sheet.getActiveRange(), SpreadsheetApp.CopyPasteType.PASTE_VALUES, false);
rowsCopiedpasted++;
}
}
}
When I am in the sheet and click on the cell in column A of a row with a "Y" value this works, but I need it to go through the whole sheet and copy/paste values of all rows with "Y" in column W.
Try this:
function Optimize() {
const sh = SpreadsheetApp.getActiveSheet();
const rg = sh.getDataRange();
const vs = rg.getValues();
const lc = sh.getLastColumn();
let o = vs.forEach((r,i) => {
if(r[22] == "Y") {
sh.getRange(i + 1, lc + 1,1,lc).setValues([r])
}
});
}

ifelse and return in the for loop

I need a help for my syntax.
library(e1071)
priori <- function (I, N, M) {
a <- as.matrix(runif(I, min = 0.65, max = 1.70))
b <- as.matrix(runif(I, min = -2.80, max = 2.80))
c <- as.matrix(runif(I, min = 0.00, max = 0.35))
k <- c(rnorm(N*20/100, 0, 1), rnorm(N*80/100,0, 0.01))
M <- cbind(b,a,c)
data <- as.data.frame(rmvlogis(N, M, IRT = FALSE, link = "logit", z.vals = k))
print(data)}
This is my syntax which is generate data.
priori.list <- vector("list", 3)
names(priori.list) <- paste0("L", seq_along(priori.list))
priori.sum.list <- vector("list", 3)
for (i in 1:3) {
for (j in 1:100) {
priori.list$L1[[j]] <- priori(10,100, M="2PL")
priori.list$L2[[j]] <- priori(20,500, M="2PL")
priori.list$L3[[j]] <- priori(40,1000,M="3PL")
priori.sum.list [[i]][[j]] <- rowSums(priori.list[[i]][[j]])
print(kurtosis(priori.sum.list[[i]][[j]]))
if(skewness(priori.sum.list[[i]][[j]])>=-1 | skewness(priori.sum.list[[i]][[j]]>=1)
& kurtosis(priori.sum.list[[i]][[j]])>=-1 | kurtosis(priori.sum.list[[i]][[j]]>=1))
{NA}
else
{return(j=j-1)}}}
Then I do a data list from syntax. I want to create a loop according to the skewness and kurtosis coefficient, but I couldn't. My purpose: If the skewness and kurtosis coefficient is outside 1 and -1, save to list if not regenerate. Can You help me for correct syntax? Thank You.

Applying popbio "projection.matrix" to multiple fertilities and generate list of matrices

I usually find the answers to my questions by looking around here (I'm glad stackovergflow exists!), but I haven't found the answer to this one... I hope you can help me :)
I am using the projection.matrix() function from the "popbio" package to create transition matrices. In the function, you have to specify the "stage" and "fate" (both categorical variables), and the "fertilities" (a numeric column).
Everything works fine, but I would like to apply the function to 1:n fertility columns within the data frame, and get a list of matrices generated from the same categorical variables with the different fertility values.
This is how my data frame looks like (I only include the variables I am using for this question):
stage.fate = data.frame(replicate(2, sample(0:6,40,rep=TRUE)))
stage.fate$X1 = as.factor(stage.fate$X1)
stage.fate$X2 = as.factor(stage.fate$X2)
fertilities = data.frame(replicate(10,rnorm(40, .145, .045)))
df = cbind(stage.fate, fertilities)
colnames(df)[1:2]=c("stage", "fate")
prefix = "control"
suffix = seq(1:10)
fer.names = (paste(prefix ,suffix , sep="."))
colnames(df)[3:12] = c(fer.names)
Using
library(popbio)
projection.matrix(df, fertility=control.1)
returns a single transition matrix with the fertility values incorporated into the matrix.
My problem is that I would like to generate a list of matrices with the different fertility values in one go (in reality the length of my data is >=300, and the fertility columns ~100 for each of four different treatments...).
I will appreciate your help!
-W
PS This is how the function in popbio looks like:
projection.matrix =
function (transitions, stage = NULL, fate = NULL, fertility = NULL,
sort = NULL, add = NULL, TF = FALSE)
{
if (missing(stage)) {
stage <- "stage"
}
if (missing(fate)) {
fate <- "fate"
}
nl <- as.list(1:ncol(transitions))
names(nl) <- names(transitions)
stage <- eval(substitute(stage), nl, parent.frame())
fate <- eval(substitute(fate), nl, parent.frame())
if (is.null(transitions[, stage])) {
stop("No stage column matching ", stage)
}
if (is.null(transitions[, fate])) {
stop("No fate column matching ", fate)
}
if (missing(sort)) {
sort <- levels(transitions[, stage])
}
if (missing(fertility)) {
fertility <- intersect(sort, names(transitions))
}
fertility <- eval(substitute(fertility), nl, parent.frame())
tf <- table(transitions[, fate], transitions[, stage])
T_matrix <- try(prop.table(tf, 2)[sort, sort], silent = TRUE)
if (class(T_matrix) == "try-error") {
warning(paste("Error sorting matrix.\n Make sure that levels in stage and fate columns\n match stages listed in sort option above.\n Printing unsorted matrix instead!\n"),
call. = FALSE)
sort <- TRUE
T_matrix <- prop.table(tf, 2)
}
T_matrix[is.nan(T_matrix)] <- 0
if (length(add) > 0) {
for (i in seq(1, length(add), 3)) {
T_matrix[add[i + 0], add[i + 1]] <- as.numeric(add[i +
2])
}
}
n <- length(fertility)
F_matrix <- T_matrix * 0
if (n == 0) {
warning("Missing a fertility column with individual fertility rates\n",
call. = FALSE)
}
else {
for (i in 1:n) {
fert <- tapply(transitions[, fertility[i]], transitions[,
stage], mean, na.rm = TRUE)[sort]
F_matrix[i, ] <- fert
}
}
F_matrix[is.na(F_matrix)] <- 0
if (TF) {
list(T = T_matrix, F = F_matrix)
}
else {
T_matrix + F_matrix
}
}
<environment: namespace:popbio>
My question was answered via ResearchGate by Caner Aktas
Answer:
fertility.list<-vector("list",length(suffix))
names(fertility.list)<-fer.names
for(i in suffix) fertility.list[[i]]<-projection.matrix(df,fertility=fer.names[i])
fertility.list
Applying popbio “projection.matrix” to multiple fertilities and generate list of matrices?. Available from: https://www.researchgate.net/post/Applying_popbio_projectionmatrix_to_multiple_fertilities_and_generate_list_of_matrices#5578524f60614b1a438b459b [accessed Jun 10, 2015].

LINQ Grouping: Is there a cleaner way to do this without a for loop

I am trying to create a very simple distribution chart and I want to display the counts of tests score percentages in their corresponding 10's ranges.
I thought about just doing the grouping on the Math.Round((d.Percentage/10-0.5),0)*10 which should give me the 10's value....but I wasn't sure the best way to do this given that I would probably have missing ranges and all ranges need to appear even if the count is zero. I also thought about doing an outer join on the ranges array but since I'm fairly new to Linq so for the sake of time I opted for the code below. I would however like to know what a better way might be.
Also note: As I tend to work with larger teams with varying experience levels, I'm not all that crazy about ultra compact code unless it remains very readable to the average developer.
Any suggestions?
public IEnumerable<TestDistribution> GetDistribution()
{
var distribution = new List<TestDistribution>();
var ranges = new int[] { 0, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 110 };
var labels = new string[] { "0%'s", "10%'s", "20%'s", "30%'s", "40%'s", "50%'s", "60%'s", "70%'s", "80%'s", "90%'s", "100%'s", ">110% "};
for (var n = 0; n < ranges.Count(); n++)
{
var count = 0;
var min = ranges[n];
var max = (n == ranges.Count() - 1) ? decimal.MaxValue : ranges[n+1];
count = (from d in Results
where d.Percentage>= min
&& d.Percentage<max
select d)
.Count();
distribution.Add(new TestDistribution() { Label = labels[n], Frequency = count });
}
return distribution;
}
// ranges and labels in a list of pairs of them
var rangesWithLabels = ranges.Zip(labels, (r,l) => new {Range = r, Label = l});
// create a list of intervals (ie. 0-10, 10-20, .. 110 - max value
var rangeMinMax = ranges.Zip(ranges.Skip(1), (min, max) => new {Min = min, Max = max})
.Union(new[] {new {Min = ranges.Last(), Max = Int32.MaxValue}});
//the grouping is made by the lower bound of the interval found for some Percentage
var resultsDistribution = from c in Results
group c by
rangeMinMax.FirstOrDefault(r=> r.Min <= c.Percentage && c.Percentage < r.Max).Min into g
select new {Percentage = g.Key, Frequency = g.Count() };
// left join betweem the labels and the results with frequencies
var distributionWithLabels =
from l in rangesWithLabels
join r in resultsDistribution on l.Range equals r.Percentage
into rd
from r in rd.DefaultIfEmpty()
select new TestDistribution{
Label = l.Label,
Frequency = r != null ? r.Frequency : 0
};
distribution = distributionWithLabels.ToList();
Another solution if the ranges and labels can be created in another way
var ranges = Enumerable.Range(0, 10)
.Select(c=> new {
Min = c * 10,
Max = (c +1 )* 10,
Label = (c * 10) + "%'s"})
.Union(new[] { new {
Min = 100,
Max = Int32.MaxValue,
Label = ">110% "
}});
var resultsDistribution = from c in Results
group c by ranges.FirstOrDefault(r=> r.Min <= c.Percentage && c.Percentage < r.Max).Min
into g
select new {Percentage = g.Key, Frequency = g.Count() };
var distributionWithLabels =
from l in ranges
join r in resultsDistribution on l.Min equals r.Percentage
into rd
from r in rd.DefaultIfEmpty()
select new TestDistribution{
Label = l.Label,
Frequency = r != null ? r.Frequency : 0
};
This works
public IEnumerable<TestDistribution> GetDistribution()
{
var range = 12;
return Enumerable.Range(0, range).Select(
n => new TestDistribution
{
Label = string.Format("{1}{0}%'s", n*10, n==range-1 ? ">" : ""),
Frequency =
Results.Count(
d =>
d.Percentage >= n*10
&& d.Percentage < ((n == range - 1) ? decimal.MaxValue : (n+1)*10))
});
}

Applying nlminb to subsets of data (by index or label) and store what the program returns as a new data frame

I was wondering if anyone could kindly help me with this seemingly easy task. I'm using nlminb to conduct optimization and compute some statistics by index. Here's an example from nlminb help.
> x <- rnbinom(100, mu = 10, size = 10)
> hdev <- function(par) {
+ -sum(dnbinom(x, mu = par[1], size = par[2], log = TRUE))
+ }
> nlminb(c(9, 12), hdev)
$par
[1] 9.730000 5.954936
$objective
[1] 297.2074
$convergence
[1] 0
$message
[1] "relative convergence (4)"
$iterations
[1] 10
$evaluations
function gradient
12 27
Suppose I generate random variables x, y, and z where z acts as an index (from 1 to 3).
> x <- rnbinom(100, mu = 10, size = 10)
> y <- rnbinom(100, mu = 10, size = 10)
> z <- rep(1:3, length=100)
> A <- cbind(x,y,z)
> hdev <- function(par) {
+ -sum(dnbinom(x+y, mu = par[1], size = par[2], log = TRUE))}
How can I apply nlminb(c(9, 12), hdev) to the data set by index z? In other words, I would like to compute nlminb(c(9, 12), hdev) for z=1, z=2, and z=3 separately. I tried by(A, z, function(A) nlminb(c(9,12), hdev)) and sparseby(A, z, function(A) nlminb(c(9,12), hdev)), but they return exactly the same values for each value of z.
I would like to turn each output into a new data frame so that it will become a 3X2 matrix.
[1] Z1_ANSWER_1 Z1_ANSWER_2
[2] Z2_ANSWER_1 Z2_ANSWER_2
[3] Z3_ANSWER_1 Z3_ANSWER_2
Since nlminb returns the summary of statistics, I needed to use CASEZ1<-nlminb$par, CASEZ2<-nlminb$par, CASEZ3<-nlminb$par and then use cbind to combine them. However, I would like to automate this process as the real data I'm working on has a lot more categories than z presented here.
If I'm not making myself clear, please let me know. I'll see if I can replicate the actual data set and functions I'm working on (I just don't have them on this computer).
Thank you very much in advance.
Let me try an approach
x <- rnbinom(100, mu = 10, size = 10)
y <- rnbinom(100, mu = 10, size = 10)
z <- rep(1:3, length=100)
A <- as.data.frame(cbind(x,y,z))
At first load the plyr library
library(plyr)
The following code returns the results for each z
dlply(A, .(z), function(x) {
hdev <- function(par, mydata) {-sum(dnbinom(mydata, mu = par[1], size = par[2], log = TRUE))}
nlminb(c(9, 12), hdev, mydata=t(as.vector(x[1] + as.vector(x[2]))))
}
)
Now, with this one you will get a 3x2 dataframe with the $par results
ddply(A, .(z), function(x) {
hdev <- function(par, mydata) {-sum(dnbinom(mydata, mu = par[1], size = par[2], log = TRUE))}
res <- nlminb(c(9, 12), hdev, mydata=t(as.vector(x[1] + as.vector(x[2]))))
return(res$par)
}
)

Resources